perm filename MAD.F4[AK,LCS] blob sn#561076 filedate 1981-02-03 generic text, type T, neo UTF8
00100		DIMENSION I(100)
00110		NS='SA '
00120		M='316AA'
00140		M=M-2
00160		MM='.X16'
00180		NX='RS'
00200	1	FORMAT(100A1)
00300	2	FORMAT(' TYPE INPUT NAME  '$)
00400	3	FORMAT(' TYPE OUTPUT NAME   '$)
00450	30	FORMAT(' TYPE FIRST MS NAME.EXT  '$)
00500	4	FORMAT(3A5)
00550		J=0
00600		TYPE 2
00700		ACCEPT 4,NAM
00800		TYPE 3
00900		ACCEPT 4,NAM2
00950		TYPE 30
00975		ACCEPT 4,M,MM
00987		M=M-2
01000		CALL IFILE(20,NAM)
01100		CALL DEFINE(1,0,NONO,NAM2)
01200		N='G STF'
01300		WRITE(1,4)N
01400	5	READ(20,1,END=100)I
01420		IF(I(1).NE.'S'.OR.I(2).NE.'P')GO TO 8
01440		IF(J.EQ.0)GO TO 10
01460		N='SA '
01470		M=M+2
01480		WRITE(1,4)NS,M,MM
01520		WRITE(1,4)NX
01600	10	J=-1
01620	8	IF(I(1).NE.'I')GO TO 6
01700		IF(I(2).NE.'N')GO TO 6
01750		CALL SHORT(I)
01800		IF(I(3).EQ.'0')GO TO 7
01900		READ(20,1)I
02000		IF(I(1).NE.'1'.OR.I(2).NE.' ')GO TO 6
02100		GO TO 5
02200	7	READ(20,1)I
02300		CALL SHORT(I)
02400		READ(20,1)I
02500		IF(I(1).NE.'B'.OR.I(2).NE.'A')GO TO 9
02600	6	CALL SHORT(I)
02700		GO TO 5
02800	9	N='-BA/'
02900		WRITE(1,4)N
03000		GO TO 6
03020	100	M=M+2
03030		WRITE(1,4)NS,M,MM
03035		END
03040	
03060		SUBROUTINE SHORT(I)
03080		DIMENSION I(1)
03100		DO 1 K=100,1,-1
03120	1	IF(I(K).NE.' ')GO TO 2
03130		K=1
03140	2	WRITE(1,3)(I(J),J=1,K)
03150	CC	TYPE 3,(I(J),J=1,K)
03160	3	FORMAT(100A1)
03180		END